MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 07 - 1991/07.04 Apr 91/NonStandard File/NonStandard File Unit

Text File | 1991-02-08 | 13.2 KB | 572 lines | [TEXT/PJMM]

{****************************}
{}
{    Non-Standard File Unit}
{        Created by Steve Sheets}
{}
{        Provides 4 different new user interfaces for}
{        the Get & Put dialogs.}
{}
{****************************}


unit NonStandardFile;

interface

    type
        SFTypeListPtr = ^SFTypeList;

        StrArray = array[1..1] of Str255;
        StrArrayPtr = ^StrArray;

{    Four new Put & Get File Routines}

    procedure NSPutFile (thePrompt, theOrigName: Str255;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255);

    procedure NSSelectPutFile (thePrompt, theSelectPrompt, theOrigName: Str255;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255;
                                    var theFlag: BOOLEAN);

    procedure NSIconPutFile (theOrigName: Str255;
                                    theDefaultNum: INTEGER;
                                    theIcon1, theIcon2, theIcon3, theIcon4: Handle;
                                    theName1, theName2, theName3, theName4: Str255;
                                    thePrompt1, thePrompt2, thePrompt3, thePrompt4: Str255;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255;
                                    var theNum: INTEGER);

    procedure NSGetFile (thePrompt: Str255;
                                    theNumTypes: INTEGER;
                                    theTypeListPtr: SFTypeListPtr;
                                    theNameListPtr: StrArrayPtr;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255;
                                    var theType: OSType);

{************************************}

{    External references to these procedures.}
{    Do not call them outside this unit}

    function NSSelectPutDlg (item: INTEGER;
                                    theDialog: DialogPtr): INTEGER;

    procedure NSIconItem (theWindow: WindowPtr;
                                    itemNo: INTEGER);

    function NSIconPutDlg (item: INTEGER;
                                    theDialog: DialogPtr): INTEGER;

    procedure NSPopUpItem (theWindow: WindowPtr;
                                    itemNo: INTEGER);

    function NSGetFileFilter (paramBlock: ParmBlkPtr): BOOLEAN;

    function NSGetDlg (item: INTEGER;
                                    theDialog: DialogPtr): INTEGER;

implementation

    const
        kNSGetID = 500;
        kNSPutID = 501;
        kNSSelectPutID = 502;
        kNSIconPutID = 503;

        kGetPopUpID = 254;
        kGetPopUpItem = 11;
        kGetPopUpPrompt = 12;

        kPutPrompt = 3;
        kPutNoSelectSwitch = 9;
        kPutSelectSwitch = 10;
        kPutIcon1 = 9;

        kMaxIcons = 4;

    type
        IconStrPtrArray = array[1..kMaxIcons] of StringPtr;

    var
        gNSCurNum, gNSMaxNum: INTEGER;
        gNSTypeListPtr: SFTypeListPtr;
        gNSPromptListPtr: IconStrPtrArray;
        gNSNameListPtr: IconStrPtrArray;
        gNSFirst, gNSSelect: BOOLEAN;
        gNSMenuHdl: MenuHandle;
        gNSBoxs: array[1..kMaxIcons] of Rect;
        gNSIcons: array[1..kMaxIcons] of Handle;
        gNSPrompt, gNSAltPrompt: Str255;

{************************************}

{    NSPutFile routines}

    procedure NSPutFile (thePrompt, theOrigName: Str255;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255);
        var
            tempPt: Point;
            tempReply: SFReply;
    begin
        tempPt.v := 40;
        tempPt.h := 60;
        theGood := FALSE;

        SFPPutFile(tempPt, thePrompt, theOrigName, nil, tempReply, kNSPutID, nil);

        with tempReply do
            if good then
                begin
                    theGood := TRUE;
                    theRefNum := vRefNum;
                    theFileName := fName;
                end;
    end;

{************************************}

{    NSSelectPutFile routines}

    function NSSelectPutDlg (item: INTEGER;
                                    theDialog: DialogPtr): INTEGER;

        procedure SetPrompt;
            var
                tempNum, tempV1, tempV2: INTEGER;
                tempHdl: Handle;
                tempRect: Rect;
        begin
            GetDItem(theDialog, kPutPrompt, tempNum, tempHdl, tempRect);
            if tempHdl <> nil then
                begin
                    if gNSSelect then
                        SetIText(tempHdl, gNSAltPrompt)
                    else
                        SetIText(tempHdl, gNSPrompt);
                end;

            if gNSSelect then
                begin
                    tempV1 := 0;
                    tempV2 := 1;
                end
            else
                begin
                    tempV1 := 1;
                    tempV2 := 0;
                end;

            GetDItem(theDialog, kPutNoSelectSwitch, tempNum, tempHdl, tempRect);
            if tempHdl <> nil then
                SetCtlValue(ControlHandle(tempHdl), tempV1);
            GetDItem(theDialog, kPutSelectSwitch, tempNum, tempHdl, tempRect);
            if tempHdl <> nil then
                SetCtlValue(ControlHandle(tempHdl), tempV2);
        end;

    begin
        if gNSFirst then
            begin
                SetPrompt;
                gNSFirst := FALSE;
            end;

        if item = kPutSelectSwitch then
            begin
                gNSSelect := TRUE;
                SetPrompt;
                item := 100;
            end
        else if item = kPutNoSelectSwitch then
            begin
                gNSSelect := FALSE;
                SetPrompt;
                item := 100;
            end;

        NSSelectPutDlg := item;
    end;

    procedure NSSelectPutFile (thePrompt, theSelectPrompt, theOrigName: Str255;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255;
                                    var theFlag: BOOLEAN);
        var
            tempPt: Point;
            tempReply: SFReply;
    begin
        theGood := FALSE;

        tempPt.v := 40;
        tempPt.h := 60;

        gNSFirst := TRUE;
        gNSSelect := FALSE;
        gNSPrompt := thePrompt;
        gNSAltPrompt := theSelectPrompt;
        SFPPutFile(tempPt, thePrompt, theOrigName, @NSSelectPutDlg, tempReply, kNSSelectPutID, nil);

        with tempReply do
            if good then
                begin
                    theGood := TRUE;
                    theRefNum := vRefNum;
                    theFileName := fName;
                    theFlag := gNSSelect;
                end;
    end;

{************************************}

{    NSIconPutFile routines}

    procedure DrawNSIcon (theNum: INTEGER;
                                    theHiliteFlag: BOOLEAN);
        var
            tempBitMap: BitMap;
            tempPort: GrafPtr;
            tempRect, tempRect2: Rect;
            tempFont, tempSize, tempLen, tempCenter: INTEGER;
    begin
        if (theNum > 0) and (theNum <= kMaxIcons) then
            if gNSIcons[theNum] <> nil then
                begin
                    GetPort(tempPort);

                    with gNSBoxs[theNum] do
                        begin
                            tempCenter := ((right + left) div 2);
                            tempRect.top := top;
                            tempRect.bottom := top + 32;
                            tempRect.left := tempCenter - 16;
                            tempRect.right := tempRect.left + 32;
                        end;

                    PlotIcon(tempRect, gNSIcons[theNum]);

                    if gNSNameListPtr[theNum]^ <> '' then
                        begin
                            tempFont := tempPort^.txFont;
                            tempSize := tempPort^.txSize;

                            TextFont(1);
                            TextSize(10);

                            tempLen := StringWidth(gNSNameListPtr[theNum]^);
                            with gNSBoxs[theNum] do
                                begin
                                    tempRect2.top := bottom - 14;
                                    tempRect2.bottom := bottom;
                                    tempRect2.left := tempCenter - (tempLen div 2) - 4;
                                    tempRect2.right := tempRect2.left + tempLen + 8;
                                end;

                            TextBox(POINTER(@gNSNameListPtr[theNum]^[1]), Length(gNSNameListPtr[theNum]^), tempRect2, teJustCenter);

                            TextFont(tempFont);
                            TextSize(tempSize);
                        end;

                    if theHiliteFlag then
                        begin
                            Hlock(gNSIcons[theNum]);
                            tempBitMap.baseaddr := POINTER(ORD4(gNSIcons[theNum]^) + $80);
                            tempBitMap.rowbytes := 4;
                            SetRect(tempBitMap.bounds, 0, 0, 32, 32);

                            BitClr(Ptr($938), 0);
                            CopyBits(tempBitMap, tempPort^.portBits, tempBitMap.bounds, tempRect, srcXor, nil);

                            HUnlock(gNSIcons[theNum]);

                            if gNSNameListPtr[theNum]^ <> '' then
                                begin
                                    BitClr(Ptr($938), 0);
                                    InvertRect(tempRect2);
                                end;
                        end;
                end;
    end;

    procedure NSIconItem (theWindow: WindowPtr;
                                    itemNo: INTEGER);
    begin
        itemNo := itemNo - kPutIcon1 + 1;
        if (itemNo >= 1) and (itemNo <= kMaxIcons) then
            DrawNSIcon(itemNo, itemNo = gNSCurNum);
    end;

    function NSIconPutDlg (item: INTEGER;
                                    theDialog: DialogPtr): INTEGER;
        var
            tempNum, tempCount: INTEGER;
            tempHdl: Handle;
            tempRect: Rect;

        procedure SetPrompt;
        begin
            GetDItem(theDialog, kPutPrompt, tempNum, tempHdl, tempRect);
            if tempHdl <> nil then
                SetIText(tempHdl, gNSPromptListPtr[gNSCurNum]^);
        end;

    begin
        if gNSFirst then
            begin
                SetPrompt;

                for tempCount := 1 to kMaxIcons do
                    begin
                        GetDItem(theDialog, tempCount - 1 + kPutIcon1, tempNum, tempHdl, gNSBoxs[tempCount]);
                        tempHdl := @NSIconItem;
                        SetDItem(theDialog, tempCount - 1 + kPutIcon1, tempNum, tempHdl, gNSBoxs[tempCount]);
                    end;

                gNSFirst := FALSE;
            end;

        tempNum := item - kPutIcon1 + 1;
        if (tempNum >= 1) and (tempNum <= kMaxIcons) then
            begin
                item := 100;
                if (gNSIcons[tempNum] <> nil) and (tempNum <> gNSCurNum) then
                    begin
                        DrawNSIcon(gNSCurNum, FALSE);
                        DrawNSIcon(tempNum, TRUE);
                        gNSCurNum := tempNum;
                        SetPrompt;
                    end;
            end;

        NSIconPutDlg := item;
    end;

    procedure NSIconPutFile (theOrigName: Str255;
                                    theDefaultNum: INTEGER;
                                    theIcon1, theIcon2, theIcon3, theIcon4: Handle;
                                    theName1, theName2, theName3, theName4: Str255;
                                    thePrompt1, thePrompt2, thePrompt3, thePrompt4: Str255;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255;
                                    var theNum: INTEGER);
        var
            tempPt: Point;
            tempReply: SFReply;
    begin
        theGood := FALSE;

        if (theDefaultNum >= 1) and (theDefaultNum <= kMaxIcons) then
            begin
                tempPt.v := 40;
                tempPt.h := 60;

                gNSFirst := TRUE;
                gNSCurNum := theDefaultNum;
                gNSNameListPtr[1] := @theName1;
                gNSNameListPtr[2] := @theName2;
                gNSNameListPtr[3] := @theName3;
                gNSNameListPtr[4] := @theName4;
                gNSPromptListPtr[1] := @thePrompt1;
                gNSPromptListPtr[2] := @thePrompt2;
                gNSPromptListPtr[3] := @thePrompt3;
                gNSPromptListPtr[4] := @thePrompt4;
                gNSIcons[1] := theIcon1;
                gNSIcons[2] := theIcon2;
                gNSIcons[3] := theIcon3;
                gNSIcons[4] := theIcon4;

                SFPPutFile(tempPt, '', theOrigName, @NSIconPutDlg, tempReply, kNSIconPutID, nil);

                with tempReply do
                    if good then
                        begin
                            theGood := TRUE;
                            theRefNum := vRefNum;
                            theFileName := fName;
                            theNum := gNSCurNum;
                        end;
            end;
    end;

{************************************}

{    NSGetFile routines}

    procedure DrawNSPopup;
        var
            tempStr: Str255;
    begin
        FrameRect(gNSBoxs[1]);
        MoveTo(gNSBoxs[1].left, gNSBoxs[1].bottom);
        LineTo(gNSBoxs[1].right, gNSBoxs[1].bottom);
        LineTo(gNSBoxs[1].right, gNSBoxs[1].top);

        MoveTo(gNSBoxs[1].left + 4, gNSBoxs[1].bottom - 6);
        if gNSCurNum = 0 then
            DrawString('All Files')
        else
            begin
                GetItem(gNSMenuHdl, gNSCurNum + 2, tempStr);
                DrawString(tempStr);
            end;
    end;

    procedure NSPopUpItem (theWindow: WindowPtr;
                                    itemNo: INTEGER);
    begin
        if itemNo = kGetPopUpItem then
            DrawNSPopup;
    end;

    function NSGetFileFilter (paramBlock: ParmBlkPtr): BOOLEAN;
        var
            tempFlag: BOOLEAN;
            tempType: OSType;
            tempCount: INTEGER;
    begin
        tempFlag := TRUE;

        tempType := paramBlock^.ioFlFndrInfo.fdType;
        if gNSCurNum = 0 then
            begin
                for tempCount := 0 to gNSMaxNum - 1 do
                    if tempFlag then
                        if gNSTypeListPtr^[tempCount] = tempType then
                            tempFlag := FALSE;
            end
        else
            begin
                if gNSTypeListPtr^[gNSCurNum - 1] = tempType then
                    tempFlag := FALSE;
            end;

        NSGetFileFilter := tempFlag;
    end;

    function NSGetDlg (item: INTEGER;
                                    theDialog: DialogPtr): INTEGER;
        var
            tempType: INTEGER;
            tempHdl: Handle;
            tempNum, tempNewNum: INTEGER;
            tempLong: LongInt;
            tempRect: Rect;
            tempPt: Point;

    begin
        if gNSFirst then
            begin
                GetDItem(theDialog, kGetPopUpPrompt, tempNum, tempHdl, tempRect);
                if tempHdl <> nil then
                    SetIText(tempHdl, gNSPrompt);

                GetDItem(theDialog, kGetPopUpItem, tempType, tempHdl, gNSBoxs[1]);
                tempHdl := @NSPopUpItem;
                SetDItem(theDialog, kGetPopUpItem, tempType, tempHdl, gNSBoxs[1]);
                with gNSBoxs[1] do
                    begin
                        bottom := bottom - 1;
                        right := right - 1;
                    end;
                gNSFirst := FALSE;
            end;

        if item = kGetPopUpItem then
            begin
                if gNSCurNum = 0 then
                    tempNum := 1
                else
                    tempNum := gNSCurNum + 2;

                CheckItem(gNSMenuHdl, tempNum, TRUE);
                InsertMenu(gNSMenuHdl, -1);
                tempPt := gNSBoxs[1].topleft;
                LocalToGlobal(tempPt);
                BitClr(Ptr($938), 0);
                InvertRect(gNSBoxs[1]);
                tempLong := PopUpMenuSelect(gNSMenuHdl, tempPt.v, tempPt.h, tempNum);
                BitClr(Ptr($938), 0);
                InvertRect(gNSBoxs[1]);
                DeleteMenu(kGetPopUpID);
                CheckItem(gNSMenuHdl, tempNum, FALSE);

                if tempLong <> 0 then
                    begin
                        tempNewNum := LoWord(tempLong);
                        if tempNewNum <> tempNum then
                            begin
                                if tempNewNum = 1 then
                                    gNSCurNum := 0
                                else
                                    gNSCurNum := tempNewNum - 2;

                                item := 101;
                                EraseRect(gNSBoxs[1]);
                                DrawNSPopup;
                            end;
                    end;
            end;

        NSGetDlg := item;
    end;

    procedure NSGetFile (thePrompt: Str255;
                                    theNumTypes: INTEGER;
                                    theTypeListPtr: SFTypeListPtr;
                                    theNameListPtr: StrArrayPtr;
                                    var theGood: BOOLEAN;
                                    var theRefNum: INTEGER;
                                    var theFileName: Str255;
                                    var theType: OSType);
        var
            tempPt: Point;
            tempReply: SFReply;
            tempCount: INTEGER;
    begin
        theGood := FALSE;
        theRefNum := -1;
        theFileName := '';
        theType := '    ';

        if (theNumTypes > 0) and (theTypeListPtr <> nil) then
            begin
                gNSCurNum := 0;
                gNSMaxNum := theNumTypes;
                gNSTypeListPtr := theTypeListPtr;
                gNSPrompt := thePrompt;
                gNSFirst := TRUE;
                gNSMenuHdl := NewMenu(kGetPopUpID, 'NS');
                AppendMenu(gNSMenuHdl, 'All Files;(-');
                for tempCount := 1 to theNumTypes do
                    AppendMenu(gNSMenuHdl, theNameListPtr^[tempCount]);

                tempPt.v := 40;
                tempPt.h := 60;
                SFPGetFile(tempPt, '', @NSGetFileFilter, theNumTypes, theTypeListPtr^, @NSGetDlg, tempReply, kNSGetID, nil);

                DisposeMenu(gNSMenuHdl);

                with tempReply do
                    if good then
                        begin
                            theGood := TRUE;
                            theRefNum := vRefNum;
                            theFileName := fName;
                            theType := fType;
                        end
            end;
    end;

end.